Aminet 39/Aminet 39 (2000)(Schatztruhe)[!][Oct 2000].iso/Aminet/biz/swood/FW_AllInOne.lha/Makros/MoreTextBlock

Text File | 1998-01-18 | 6KB | 282 lines

/* Optimized with RexxOpt 1.7 */

Parse ARG FW
if ~show('L',"rexxreqtools.library") then;do
if ~addlib('rexxreqtools.library',0,-30,0) then;do
'ShowMessage 1 1 "Fehler...." "Benötige RexxReqTools.library" " A B B R U C H ! !" "Okay" "" ""'
exit
end
end
IF ~SHOW('LIBRARIES','tritonrexx.library') THEN;DO
IF ~ADDLIB('tritonrexx.library',10,-30,0) THEN;DO
'ShowMessage 2 1 "Fehler...." "Benötige TritonRexx.library" "" "Abbruch" "" ""'
Exit
END
END
R='0A'X
SIGNAL ON syntax
If open('Hilfe',"S:FW_Paket.prefs","R") then;do
HilfeVerz=readln('Hilfe')
Call Close('Hilfe')
End
else HilfeVerz=''
If FW='' then;do
Address='FinalW'
Options results
STATUS PORTNAME
FW=result
End
address(FW)
apptags='TRCA_Name     MoreTextblock',
'TRCA_LongName "MoreTextBlock"',
'TRCA_Info     "Makro für Finalwriter"',
'TRCA_Version  "2.1 registered"',
'TRCA_Release  "3"',
'TRCA_Date     "09.01.98"',
'TAG_END'
windowtags=WindowID(1),
WindowPosition('TRWP_CENTERDISPLAY'),
WindowFlags('TRWF_NOZIPGADGET|TRWF_NOMINTEXTWIDTH|TRWF_ACTIVATESTRGAD'),
PubScreenName('FinalWriterPubScreen'),
WindowTitle('MoreTextBlock'),
BeginMenu('Projekt'),
MenuItem('Voreinsteller...',102),
'ItemBarlabel',
MenuItem('Q_Verlassen',104),
BeginMenu('?'),
MenuItem('?_Info',101),
MenuItem('H_Hilfe',103),
'HorizGroupAC',
'SpaceS',
'VertGroupA',
'SpaceS',
'HorizGroupAC',
CheckBox(6),
'SpaceS',
StringGadget('',10) 'TRAT_VALUE 256',
'EndGroup',
'Space',
'HorizGroupEC',
Button(' _Anwenden',2),
'SpaceS',
Button('_Erneuern',3),
'SpaceS',
Button('Ab_bruch',4),
'EndGroup',
'SpaceS',
'EndGroup',
'SpaceS',
'EndGroup',
'EndProject'
app=TR_CREATEAPP('TRCA_Name MTB')
IF app ~='00000000'x THEN;DO
ende=0
window1=TR_OPENPROJECT(app,windowtags)
IF window1 ~='00000000'x THEN;DO
DO WHILE ende ~=1
CALL TR_WAIT(app,'')
DO WHILE TR_HANDLEMSG(app,'event')
IF event.trm_class='TRMS_NEWVALUE' THEN;DO
SELECT
WHEN event.trm_id=6 THEN;Do
CALL TR_SETATTRIBUTE(window1,6,'TRAT_VALUE',0)
Text=""
CALL program3
CALL TR_SETATTRIBUTE(window1,10,'TROB_String',Text)
END
OTHERWISE NOP
END
END
IF event.trm_class='TRMS_ACTION' THEN;DO
SELECT
WHEN event.trm_id=2 THEN;Do
String=TR_GETATTRIBUTE(window1,10,'TROB_String')
If String~="" then CALL program
END
WHEN event.trm_id=3 THEN CALL program2
WHEN event.trm_id=4 THEN ende=1
WHEN event.trm_id=101 THEN Call rtezrequest("Aus dem Makro-Paket:"||R||R||"MoreTextBlock V2.1 für FW"||R||"© 1998 Heiko Schröder","Danke für Ihre Registrierung.","Info","rt_pubscrname=FinalWriterPubScreen")
WHEN event.trm_id=102 THEN TextBlockPrefs PROMPT
WHEN event.trm_id=103 THEN address command "run Multiview PUBSCREEN=FinalWriterPubScreen "||d2c(34)||HilfeVerz||"MoreTextBlock.guide"||d2c(34)
WHEN event.trm_id=104 THEN ende=1
OTHERWISE NOP
END
END
END
IF event.trm_class='TRMS_CLOSEWINDOW' THEN ende=1
END
CALL TR_CLOSEPROJECT(window1)
END
CALL TR_DELETEAPP(app)
END
Exit
program:
GraphicTool
GetDocItemPrefs Decimal
Punkt=Result
If Punkt="Comma" then DocItemPrefs Decimal Period
STATUS Page
Seite=result
Status ScrollPos
Parse var result posx posy
xx=posx+2;a=0
Do while 1
zahl=37
If String='' then leave
text=Left(String,zahl)
if (pos(d2c(32),Text,zahl-1)=37|pos(d2c(32),String,zahl)=38) then;do
zahl=zahl-2
text=Left(String,zahl)
end
String=DelStr(String,1,zahl)
DrawTextBlock Seite posx posy+2 Text
CurrentObject
a=a+1;Object.0=a
Object.a=result
GetObjectCoords Object.a
Parse var result Seite left top weight height
SetObjectCoords Object.a Seite xx top weight height
xx=xx+weight
Redraw
End
SelectObject Object.1
Do i=Object.1 to Object.a
SelectObject i MULTIPLE
End
Group
If Punkt="Comma" then DocItemPrefs DECIMAL Comma
GraphicTool
return
program2:
a=1
GraphicTool
GetDocItemPrefs Decimal
Punkt=Result
If Punkt="Comma" then DocItemPrefs Decimal Period
CurrentObject
ObjectID=result
If ObjectID=0 then return
Ungroup
FirstObject Selected
ID=result
Object.0=a;Object.a=ID
Do While 1
NextObject ID Selected
ID=result
If ID=0 then Leave
Call Zaehlen
End
GetObjectRotation Object.1
Dreh=result
Do i=Object.1 to Object.a
SelectObject i MULTIPLE
End
Group
CurrentObject
ObjectID=result
Null=0-Dreh
SetObjectRotation ObjectID Null DELTA
Ungroup
Do i=1 to Object.0
GetObjectCoords Object.i
Parse Var result page.i left.i top.i weight.i height.i
End
left=left.1
Do i=2 to Object.0
z=i-1
left=left+weight.z
SetObjectCoords Object.i page.1 left top.1 weight.i height.i
End
SelectObject Object.1
Do i=Object.1 to Object.a
SelectObject i MULTIPLE
End
Group
CurrentObject
ObjectID=result
SetObjectRotation ObjectID Dreh DELTA
If Punkt="Comma" then DocItemPrefs DECIMAL Comma
GraphicTool
Redraw
return
program3:
a=1
GraphicTool
CurrentObject
ObjectID=result
If ObjectID=0 then;do
Texttool
Extract
Text=result
pos=1;vorbei=0
do until vorbei=1
pos=index(Text,d2c(10),pos)
if pos~=0 then Text=Overlay(' ',Text,pos)
if pos=0 then vorbei=1
end
STATUS FONTNAME
tfont=result
STATUS FONTCOLOR
tcolor=result
STATUS FONTSIZE
tsize=result
STATUS FONTLEADING
tlead=result
STATUS FONTWIDTH
twidth=result
STATUS FONTOBLIQUE
tobl=result
TextBlockTypePrefs Size tsize Leading tlead Width twidth Oblique tobl Color tcolor Font tfont
Return
End
Ungroup
FirstObject Selected
ID=result
Object.0=a;Object.a=ID
Do While 1
NextObject ID Selected
ID=result
If ID=0 then Leave
Call Zaehlen
End
Text=""
GetObjectTypeSpecs Object.1 Size Leading Width Oblique Color Font
Parse Var result tsize tlead twidth tobl tcolor tfont
TextBlockTypePrefs Size tsize Leading tlead Width twidth Oblique tobl Color tcolor Font tfont
Do i=Object.1 to Object.a
GetTextBlockText i
str=result
Text=Text||str
End
Do i=Object.1 to Object.a
SelectObject i MULTIPLE
End
Group
GraphicTool
Redraw
return
Zaehlen:
If ID~=Object.1 then;do
a=a+1
Object.0=a;Object.a=ID
End
Return
syntax:
CALL quit('Fehler' rc 'in Zeile' sigl '-' ERRORTEXT(rc)||R||SOURCELINE(sigl)||R||'Bitte informieren Sie den Autor...',20)
quit:
PARSE ARG message,rcode
IF app ~='00000000'x THEN;DO
IF message ~='' THEN
ret=rtezrequest(message,"_Okay","ACHTUNG!","rt_pubscrname=FinalWriterPubScreen")
CALL TR_DELETEAPP(app)
END
ELSE;DO
IF message ~='' THEN;DO
SAY message
SAY
OPTIONS PROMPT 'Bitte <RETURN> drücken'
PULL taste
END
END
address command "flushtrx all"
EXIT(rcode)